이번 포스트는 최근 관심을 가지고 있는 Feature selection과 관련된 내용을 담고 있다. 완벽한 번역보다는 아티클을 보고 정리한 내용들을 거칠게 정리하려고 한다. 자세한 내용은 원문 포스트 참고하길 바란다.
머신러닝은 예측 모델을 생성하기 위해서 변수(features, 또는 variables, attributes)를 사용한다. 높은 정확도를 얻기 위해서는 적절한 변수들의 조합을 사용하는 것이 필수적이다. (불명확한) 변수들을 사용하면 모델이 과적합되는 문제가 발생하기 때문에, 일반적으로 예측하고자 하는 반응변수와 가장 연관성이 높은 변수들을 찾아서 모델에 사용하길 원한다. 가능한한 적은 수의 변수를 사용하면 모델의 복잡도(complexity)를 낮출 수 있다. 다시 말해서 모델을 실행하는 시간과 컴퓨팅 파워 요구량을 줄이고, 이해하기도 쉬워진다는 의미다.
모델에 대해서 각각의 변수가 기여하는 정도를 측정하고, 변수의 수를 정하는 방법은 여러 가지가 있다. 본 아티클에서는 랜덤 포레스트 모델에 대해서 다음의 기법을 사용한다.
추가적으로, 데이터의 특성이 다를 때 위의 변수 선택 기법이 어떤 영향을 미치는지 확인하기 위해서 세 가지의 유방암 관련 데이터셋을 사용하였다. 하나는 매우 적은 수의 변수를 가지고 있으며, 다른 두 개의 데이터는 매우 큰 데이터지만, PCA를 이용해서 결과 클러스터를 다르게 하였다.
상관계수 기법, RFE, GA를 비교한 결과에 따르면, 랜덤 포레스트에 대해서 다음의 결과를 얻었다.
이 결론들은 물론 모든 데이터에 대해 일반화할 수는 없다. 위 기법들 이외에도 다양한 변수 선택 기법이 있으며, 굉장히 제한된 데이터셋에 대해서만 비교분석 하였으며, 랜덤 포레스트 모델에 대한 영향력만 분석했다. 하지만 작은 예제로도 서로 다른 변수와 파라미터가 예측 결과에 어떻게 영향을 미치는지 충분히 보여주고 있다는 점이 중요하다. 머신러닝에서는 이른바 “만능(one size fits all)”은 존재하지 않는다. 데이터를 유심히 살펴보는 것은 항상 가치있는 일이고, 모델이나 알고리즘에 대해서 생각하기 전에 데이터의 특징들에 익숙해지는 것이 중요하다. 주어진 데이터에 대해서 무언가 감을 잡았다면, 서로 다른 변수 선택 기법(또는 생성한 변수들), 모델, 파라미터들을 비교해보는 데에 시간을 투자하고, 마지막으로 다양한 머신러닝 알고리즘을 비교해보는 것이 큰 차이를 만들어낼 수 있다.
변수 선택 기법을 비교하기 위해 사용할 데이터는 Breast Cancer Wisconsin (Diagnostic) 데이터셋이다.
W.N. Street, W.H. Wolberg and O.L. Mangasarian. Nuclear feature extraction for breast tumor diagnosis. IS&T/SPIE 1993 International Symposium on Electronic Imaging: Science and Technology, volume 1905, pages 861-870, San Jose, CA, 1993.
O.L. Mangasarian, W.N. Street and W.H. Wolberg. Breast cancer diagnosis and prognosis via linear programming. Operations Research, 43(4), pages 570-577, July-August 1995.
W.H. Wolberg, W.N. Street, and O.L. Mangasarian. Machine learning techniques to diagnose breast cancer from fine-needle aspirates. Cancer Letters 77 (1994) 163-171.
W.H. Wolberg, W.N. Street, and O.L. Mangasarian. Image analysis and machine learning applied to breast cancer diagnosis and prognosis. Analytical and Quantitative Cytology and Histology, Vol. 17 No. 2, pages 77-87, April 1995.
W.H. Wolberg, W.N. Street, D.M. Heisey, and O.L. Mangasarian. Computerized breast cancer diagnosis and prognosis from fine needle aspirates. Archives of Surgery 1995;130:511-516.
W.H. Wolberg, W.N. Street, D.M. Heisey, and O.L. Mangasarian. Computer-derived nuclear features distinguish malignant from benign breast cytology. Human Pathology, 26:792–796, 1995.
데이터는 UC Irvine Machine Learning Repository에서 다운로드했다. 데이터셋의 변수들은 세포핵의 특성을 담고 있으며, 유방 세포 덩어리 세침흡인검사의 이미지 분석으로 생성되었다.
총 세 개의 데이터셋을 포함하고 있다. 첫번째 데이터셋은 아홉 개의 변수만 사용하고 있는 작은 데이터이며, 다른 두 개의 데이터는 각각 30개와 33개의 변수를 포함하고 있다. 두 데이터는 PCA로 생성되는 클러스터가 서로 다르다. 서로 다른 특성을 가지고 있는 데이터셋을 이용해서 서로 다른 변수 선택 기법의 효과를 살펴보고자 한다.
반응변수의 클래스는 다음과 같다.
세포 특징에 관한 표현형은 다음과 같다.
결측값들은 mice 패키지를 이용해서 처리한다.
bc_data <- read.table("data/breast/breast-cancer-wisconsin.data.txt",
header = FALSE, sep = ",")
colnames(bc_data) <- c("sample_code_number",
"clump_thickness",
"uniformity_of_cell_size",
"uniformity_of_cell_shape",
"marginal_adhesion",
"single_epithelial_cell_size",
"bare_nuclei",
"bland_chromatin",
"normal_nucleoli",
"mitosis",
"classes"
)
bc_data$classes <- ifelse(bc_data$classes == "2", "benign",
ifelse(bc_data$classes == "4", "malignant", NA))
bc_data[bc_data == "?"] <- NA
# how many NAs are in the data
length(which(is.na(bc_data)))
[1] 16
# impute missing data
library(mice)
bc_data[,2:10] <- apply(bc_data[, 2:10], 2, function(x) as.numeric(as.character(x)))
dataset_impute <- mice(bc_data[, 2:10], print = FALSE)
bc_data <- cbind(bc_data[, 11, drop = FALSE], mice::complete(dataset_impute, 1))
bc_data$classes <- as.factor(bc_data$classes)
# how many benign and malignant cases are there?
summary(bc_data$classes)
benign malignant
458 241
str(bc_data)
'data.frame': 699 obs. of 10 variables:
$ classes : Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 1 1 1 ...
$ clump_thickness : num 5 5 3 6 4 8 1 2 2 4 ...
$ uniformity_of_cell_size : num 1 4 1 8 1 10 1 1 1 2 ...
$ uniformity_of_cell_shape : num 1 4 1 8 1 10 1 2 1 1 ...
$ marginal_adhesion : num 1 5 1 1 3 8 1 1 1 1 ...
$ single_epithelial_cell_size: num 2 7 2 3 2 7 2 2 2 2 ...
$ bare_nuclei : num 1 10 2 4 1 10 10 1 1 1 ...
$ bland_chromatin : num 3 3 3 3 3 9 3 3 1 2 ...
$ normal_nucleoli : num 1 2 1 7 1 7 1 1 1 1 ...
$ mitosis : num 1 1 1 1 1 1 1 1 5 1 ...
두번째 데이터셋의 반응변수의 클래스는 동일하다.
데이터셋의 첫 두 칼럼은 다음과 같다.
각 세포핵에 대해서, 다음 10개의 특징이 측정되어 있다.
각각의 특징은 세 개의 기준을 측정되었다.
bc_data_2 <- read.table("data/breast/wdbc.data.txt",
header = FALSE, sep = ",")
phenotypes <- rep(c("radius",
"texture",
"perimeter",
"area",
"smoothness",
"compactness",
"concavity",
"concave_points",
"symmetry",
"fractal_dimension"), 3)
types <- rep(c("mean", "se", "largest_worst"), each = 10)
colnames(bc_data_2) <- c("ID",
"diagnosis",
paste(phenotypes, types, sep = "_")
)
# how many NAs are in the data
length(which(is.na(bc_data_2)))
[1] 0
# how many benign and malignant cases are there?
summary(bc_data_2$diagnosis)
B M
357 212
str(bc_data_2)
'data.frame': 569 obs. of 32 variables:
$ ID : int 842302 842517 84300903 84348301 84358402 843786 844359 84458202 844981 84501001 ...
$ diagnosis : Factor w/ 2 levels "B","M": 2 2 2 2 2 2 2 2 2 2 ...
$ radius_mean : num 18 20.6 19.7 11.4 20.3 ...
$ texture_mean : num 10.4 17.8 21.2 20.4 14.3 ...
$ perimeter_mean : num 122.8 132.9 130 77.6 135.1 ...
$ area_mean : num 1001 1326 1203 386 1297 ...
$ smoothness_mean : num 0.1184 0.0847 0.1096 0.1425 0.1003 ...
$ compactness_mean : num 0.2776 0.0786 0.1599 0.2839 0.1328 ...
$ concavity_mean : num 0.3001 0.0869 0.1974 0.2414 0.198 ...
$ concave_points_mean : num 0.1471 0.0702 0.1279 0.1052 0.1043 ...
$ symmetry_mean : num 0.242 0.181 0.207 0.26 0.181 ...
$ fractal_dimension_mean : num 0.0787 0.0567 0.06 0.0974 0.0588 ...
$ radius_se : num 1.095 0.543 0.746 0.496 0.757 ...
$ texture_se : num 0.905 0.734 0.787 1.156 0.781 ...
$ perimeter_se : num 8.59 3.4 4.58 3.44 5.44 ...
$ area_se : num 153.4 74.1 94 27.2 94.4 ...
$ smoothness_se : num 0.0064 0.00522 0.00615 0.00911 0.01149 ...
$ compactness_se : num 0.049 0.0131 0.0401 0.0746 0.0246 ...
$ concavity_se : num 0.0537 0.0186 0.0383 0.0566 0.0569 ...
$ concave_points_se : num 0.0159 0.0134 0.0206 0.0187 0.0188 ...
$ symmetry_se : num 0.03 0.0139 0.0225 0.0596 0.0176 ...
$ fractal_dimension_se : num 0.00619 0.00353 0.00457 0.00921 0.00511 ...
$ radius_largest_worst : num 25.4 25 23.6 14.9 22.5 ...
$ texture_largest_worst : num 17.3 23.4 25.5 26.5 16.7 ...
$ perimeter_largest_worst : num 184.6 158.8 152.5 98.9 152.2 ...
$ area_largest_worst : num 2019 1956 1709 568 1575 ...
$ smoothness_largest_worst : num 0.162 0.124 0.144 0.21 0.137 ...
$ compactness_largest_worst : num 0.666 0.187 0.424 0.866 0.205 ...
$ concavity_largest_worst : num 0.712 0.242 0.45 0.687 0.4 ...
$ concave_points_largest_worst : num 0.265 0.186 0.243 0.258 0.163 ...
$ symmetry_largest_worst : num 0.46 0.275 0.361 0.664 0.236 ...
$ fractal_dimension_largest_worst: num 0.1189 0.089 0.0876 0.173 0.0768 ...
세 번째 데이터셋의 반응변수의 클래스는 다음과 같다.
데이터셋의 첫 두 칼럼은 다음과 같다.
각 세포핵에 대해서 두 번째 데이터셋과 동일한 특성과 측정기준으로 구성된 칼럼이 있으며, 추가적으로 다음의 칼럼이 있다.
bc_data_3 <- read.table("data/breast/wpbc.data.txt",
header = FALSE, sep = ",")
colnames(bc_data_3) <- c("ID",
"outcome",
"time",
paste(phenotypes, types, sep = "_"),
"tumor_size",
"lymph_node_status"
)
bc_data_3[bc_data_3 == "?"] <- NA
# how many NAs are in the data
length(which(is.na(bc_data_3)))
[1] 4
# impute missing data
library(mice)
bc_data_3[,3:35] <- apply(bc_data_3[,3:35], 2, function(x) as.numeric(as.character(x)))
dataset_impute <- mice(bc_data_3[,3:35], print = FALSE)
bc_data_3 <- cbind(bc_data_3[, 2, drop = FALSE], mice::complete(dataset_impute, 1))
# how many recurring and non-recurring cases are there?
summary(bc_data_3$outcome)
N R
151 47
str(bc_data_3)
'data.frame': 198 obs. of 34 variables:
$ outcome : Factor w/ 2 levels "N","R": 1 1 1 1 2 2 1 2 1 1 ...
$ time : num 31 61 116 123 27 77 60 77 119 76 ...
$ radius_mean : num 18 18 21.4 11.4 20.3 ...
$ texture_mean : num 27.6 10.4 17.4 20.4 14.3 ...
$ perimeter_mean : num 117.5 122.8 137.5 77.6 135.1 ...
$ area_mean : num 1013 1001 1373 386 1297 ...
$ smoothness_mean : num 0.0949 0.1184 0.0884 0.1425 0.1003 ...
$ compactness_mean : num 0.104 0.278 0.119 0.284 0.133 ...
$ concavity_mean : num 0.109 0.3 0.126 0.241 0.198 ...
$ concave_points_mean : num 0.0706 0.1471 0.0818 0.1052 0.1043 ...
$ symmetry_mean : num 0.186 0.242 0.233 0.26 0.181 ...
$ fractal_dimension_mean : num 0.0633 0.0787 0.0601 0.0974 0.0588 ...
$ radius_se : num 0.625 1.095 0.585 0.496 0.757 ...
$ texture_se : num 1.89 0.905 0.611 1.156 0.781 ...
$ perimeter_se : num 3.97 8.59 3.93 3.44 5.44 ...
$ area_se : num 71.5 153.4 82.2 27.2 94.4 ...
$ smoothness_se : num 0.00443 0.0064 0.00617 0.00911 0.01149 ...
$ compactness_se : num 0.0142 0.049 0.0345 0.0746 0.0246 ...
$ concavity_se : num 0.0323 0.0537 0.033 0.0566 0.0569 ...
$ concave_points_se : num 0.00985 0.01587 0.01805 0.01867 0.01885 ...
$ symmetry_se : num 0.0169 0.03 0.0309 0.0596 0.0176 ...
$ fractal_dimension_se : num 0.00349 0.00619 0.00504 0.00921 0.00511 ...
$ radius_largest_worst : num 21.6 25.4 24.9 14.9 22.5 ...
$ texture_largest_worst : num 37.1 17.3 21 26.5 16.7 ...
$ perimeter_largest_worst : num 139.7 184.6 159.1 98.9 152.2 ...
$ area_largest_worst : num 1436 2019 1949 568 1575 ...
$ smoothness_largest_worst : num 0.119 0.162 0.119 0.21 0.137 ...
$ compactness_largest_worst : num 0.193 0.666 0.345 0.866 0.205 ...
$ concavity_largest_worst : num 0.314 0.712 0.341 0.687 0.4 ...
$ concave_points_largest_worst : num 0.117 0.265 0.203 0.258 0.163 ...
$ symmetry_largest_worst : num 0.268 0.46 0.433 0.664 0.236 ...
$ fractal_dimension_largest_worst: num 0.0811 0.1189 0.0907 0.173 0.0768 ...
$ tumor_size : num 5 3 2.5 2 3.5 2.5 1.5 4 2 6 ...
$ lymph_node_status : num 5 2 0 0 0 0 0 10 1 20 ...
데이터셋의 차원과 분산에 대한 아이디어를 얻기 위해서, 데이터의 샘플과 변수에 대해서 PCA 플롯을 그리도록 한다. 첫 두 주성분(principal components, PCs)는 데이터 분산의 다수를 설명할 수 있는 두 주성분을 의미한다.
# function for PCA plotting
library(pcaGoPromoter)
library(ellipse)
pca_func <- function(data, groups, title, print_ellipse = TRUE) {
# perform pca and extract scores
pcaOutput <- pca(data, printDropped = FALSE, scale = TRUE, center = TRUE)
pcaOutput2 <- as.data.frame(pcaOutput$scores)
# define groups for plotting
pcaOutput2$groups <- groups
# when plotting samples calculate ellipses for plotting (when plotting features, there are no replicates)
if (print_ellipse) {
centroids <- aggregate(cbind(PC1, PC2) ~ groups, pcaOutput2, mean)
conf.rgn <- do.call(rbind, lapply(unique(pcaOutput2$groups), function(t)
data.frame(groups = as.character(t),
ellipse(cov(pcaOutput2[pcaOutput2$groups == t, 1:2]),
centre = as.matrix(centroids[centroids$groups == t, 2:3]),
level = 0.95),
stringsAsFactors = FALSE)))
plot <- ggplot(data = pcaOutput2, aes(x = PC1, y = PC2, group = groups, color = groups)) +
geom_polygon(data = conf.rgn, aes(fill = groups), alpha = 0.2) +
geom_point(size = 2, alpha = 0.6) +
scale_color_brewer(palette = "Set1") +
labs(title = title,
color = "",
fill = "",
x = paste0("PC1: ", round(pcaOutput$pov[1], digits = 2), "% variance"),
y = paste0("PC2: ", round(pcaOutput$pov[2], digits = 2), "% variance"))
} else {
# if there are fewer than 10 groups (e.g. the predictor classes) I want to have colors from RColorBrewer
if (length(unique(pcaOutput2$groups)) <= 10) {
plot <- ggplot(data = pcaOutput2, aes(x = PC1, y = PC2, group = groups, color = groups)) +
geom_point(size = 2, alpha = 0.6) +
scale_color_brewer(palette = "Set1") +
labs(title = title,
color = "",
fill = "",
x = paste0("PC1: ", round(pcaOutput$pov[1], digits = 2), "% variance"),
y = paste0("PC2: ", round(pcaOutput$pov[2], digits = 2), "% variance"))
} else {
# otherwise use the default rainbow colors
plot <- ggplot(data = pcaOutput2, aes(x = PC1, y = PC2, group = groups, color = groups)) +
geom_point(size = 2, alpha = 0.6) +
labs(title = title,
color = "",
fill = "",
x = paste0("PC1: ", round(pcaOutput$pov[1], digits = 2), "% variance"),
y = paste0("PC2: ", round(pcaOutput$pov[2], digits = 2), "% variance"))
}
}
return(plot)
}
library(gridExtra)
library(grid)
p1 <- pca_func(data = t(bc_data[, 2:10]),
groups = as.character(bc_data$classes),
title = "Breast cancer dataset 1: Samples"
)
p2 <- pca_func(data = bc_data[, 2:10],
groups = as.character(colnames(bc_data[, 2:10])),
title = "Breast cancer dataset 1: Features",
print_ellipse = FALSE)
grid.arrange(p1, p2, ncol = 2)
h_1 <- hclust(dist(t(bc_data[, 2:10]),
method = "euclidean"),
method = "complete")
plot(h_1)
library(tidyr)
bc_data_gather <- bc_data %>%
gather(measure, value, clump_thickness:mitosis)
ggplot(data = bc_data_gather,
aes(x = value, fill = classes, color = classes)) +
geom_density(alpha = 0.3, size = 1) +
geom_rug() +
scale_fill_brewer(palette = "Set1") +
scale_color_brewer(palette = "Set1") +
facet_wrap( ~ measure, scales = "free_y", ncol = 3)
p1 <- pca_func(data = t(bc_data_2[, 3:32]),
groups = as.character(bc_data_2$diagnosis),
title = "Breast cancer dataset 2: Samples")
p2 <- pca_func(data = bc_data_2[, 3:32],
groups = as.character(colnames(bc_data_2[, 3:32])),
title = "Breast cancer dataset 2: Features",
print_ellipse = FALSE)
grid.arrange(p1, p2, ncol = 2, widths = c(0.4, 0.6))
h_2 <- hclust(dist(t(bc_data_2[, 3:32]),
method = "euclidean"),
method = "complete")
plot(h_2)
bc_data_2_gather <- bc_data_2[, -1] %>%
gather(measure, value, radius_mean:fractal_dimension_largest_worst)
ggplot(data = bc_data_2_gather, aes(x = value, fill = diagnosis, color = diagnosis)) +
geom_density(alpha = 0.3, size = 1) +
geom_rug() +
scale_fill_brewer(palette = "Set1") +
scale_color_brewer(palette = "Set1") +
facet_wrap( ~ measure, scales = "free_y", ncol = 3)
p1 <- pca_func(data = t(bc_data_3[, 2:34]),
groups = as.character(bc_data_3$outcome),
title = "Breast cancer dataset 3: Samples")
p2 <- pca_func(data = bc_data_3[, 2:34],
groups = as.character(colnames(bc_data_3[, 2:34])),
title = "Breast cancer dataset 3: Features",
print_ellipse = FALSE)
grid.arrange(p1, p2, ncol = 2, widths = c(0.4, 0.6))
h_3 <- hclust(dist(t(bc_data_3[,2:34]),
method = "euclidean"),
method = "complete")
plot(h_3)
데이터셋 1과 데이터셋 2는 양성과 음성을 잘 분류한다. 또한 해당 변수들에 기반을 둔 모델은 클래스 예측 성능이 좋을 것으로 보인다. 하지만 데이터셋 3은 서로 다른 그룹으로 군집화하지 못하는데, 이는 해당 변수들을 사용했을 때 예측 성능이 떨어질 것으로 예상된다.
데이터셋 2와 데이터셋 3의 변수들은 잘 구별되게 군집화되지 않는다. 많은 변수들이 유사한 패턴을 보이기 때문인 것으로 보인다. 따라서 세 개의 데이터셋에 대해서 적절한 변수 부분집합을 고르는 것은 서로 다른 효과를 보일 것으로 보인다.
bc_data_3_gather <- bc_data_3 %>%
gather(measure, value, time:lymph_node_status)
ggplot(data = bc_data_3_gather, aes(x = value, fill = outcome, color = outcome)) +
geom_density(alpha = 0.3, size = 1) +
geom_rug() +
scale_fill_brewer(palette = "Set1") +
scale_color_brewer(palette = "Set1") +
facet_wrap( ~ measure, scales = "free_y", ncol = 3)
변수 각각의 중요성에 대한 정보를 얻기 위해서 caret 패키지를 사용하여 랜덤 포레스트에 대해 10 x 10 CV를 수행하였다. 모델링을 위한 변수 선택을 위해 변수 중요성이 필요했다면, 완전한 데이터셋이 아닌 트레이닝 데이터에 CV를 수행하여야 한다. 하지만 데이터에 전체에 대한 정보를 얻고 싶었기 때문에 전체를 사용하였다.
library(caret)
library(doMC)
registerDoMC(cores = 4)
# prepare training scheme
control <- trainControl(method = "repeatedcv", number = 10, repeats = 10)
feature_imp <- function(model, title) {
# estimate variable importance
importance <- varImp(model, scale = TRUE)
# prepare dataframes for plotting
importance_df_1 <- importance$importance
importance_df_1$group <- rownames(importance_df_1)
importance_df_2 <- importance_df_1
importance_df_2$Overall <- 0
importance_df <- rbind(importance_df_1, importance_df_2)
plot <- ggplot() +
geom_point(data = importance_df_1,
aes(x = Overall, y = group, color = group),
size = 2) +
geom_path(data = importance_df,
aes(x = Overall, y = group,
color = group, group = group),
size = 1) +
theme(legend.position = "none") +
labs(
x = "Importance",
y = "",
title = title,
subtitle = "Scaled feature importance",
caption = "\nDetermined with Random Forest and
repeated cross validation (10 repeats, 10 times)"
)
return(plot)
}
# train the model
set.seed(27)
imp_1 <- train(classes ~ .,
data = bc_data,
method = "rf",
preProcess = c("scale", "center"),
trControl = control)
p1 <- feature_imp(imp_1, title = "Breast cancer dataset 1")
set.seed(27)
imp_2 <- train(diagnosis ~ .,
data = bc_data_2[, -1],
method = "rf",
preProcess = c("scale", "center"),
trControl = control)
p2 <- feature_imp(imp_2, title = "Breast cancer dataset 2")
set.seed(27)
imp_3 <- train(outcome ~ .,
data = bc_data_3,
method = "rf",
preProcess = c("scale", "center"),
trControl = control)
p3 <- feature_imp(imp_3, title = "Breast cancer dataset 3")
grid.arrange(p1, p2, p3, ncol = 3, widths = c(0.3, 0.35, 0.35))